home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / p063b9s.zip / UNIT / OPUSMSG.PAS < prev    next >
Pascal/Delphi Source File  |  1997-03-02  |  7KB  |  237 lines
  1. UNIT OpusMsg;
  2. {╔══════════════════════════════════════════════════════════════════════════╗}
  3. {║ Læser/skriver opus style *.msg breve          Last changed: 02.03.97  SA ║}
  4. {║                                                                          ║}
  5. {║                         (C) Copyright 1989-97 by                         ║}
  6. {║       Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager        ║}
  7. {║                                                                          ║}
  8. {║ This source may not be given to anybody, without the written permission  ║}
  9. {║ from The Portal Team.                                                    ║}
  10. {╚══════════════════════════════════════════════════════════════════════════╝}
  11. {$I POPDEFS.INC}
  12.  
  13. INTERFACE
  14.  
  15. USES Use32, PoPTypes, Dos;
  16.  
  17. CONST
  18.   MsgPrivate = $0001;
  19.   MsgCrash   = $0002;
  20.   MsgRead    = $0004;
  21.   MsgSent    = $0008;
  22.   MsgFile    = $0010;
  23.   MsgFwd     = $0020;
  24.   MsgOrphan  = $0040;
  25.   MsgKill    = $0080;
  26.   MsgLocal   = $0100;
  27.   MsgHold    = $0200;
  28.   Msgxx2     = $0400;
  29.   MsgFreq    = $0800;
  30.   MsgRReq    = $1000;
  31.   MsgRcpt    = $2000;
  32.   MsgAReq    = $4000;
  33.   MsgUpdReq  = $8000;
  34.  
  35. TYPE
  36.   MsgHdrType = RECORD
  37.                  FromUser  : String[35];
  38.                  ToUser    : String[35];
  39.                  Subject   : String[71];
  40.                  DateTime  : String[19];
  41.                  TimesRead : Word;
  42.                  DestNode  : Integer;
  43.                  OrigNode  : Integer;
  44.                  Cost      : Word;
  45.                  OrigNet   : Integer;
  46.                  DestNet   : Integer;
  47.                  DestZone  : Integer;
  48.                  OrigZone  : Integer;
  49.                  DestPoint : Integer;
  50.                  OrigPoint : Integer;
  51.                  ReplyTo   : Word;
  52.                  Attribute : Word;
  53.                  NextReply : Word;
  54.                END;
  55.  
  56. FUNCTION GetHighestMsg(CONST Path: PathStr): Word;
  57. FUNCTION ReadMsg(CONST Path:PathStr; MNum:Word; VAR Hdr: MsgHdrType; VAR TxtLen: LongInt; VAR Txt: Pointer): BOOLEAN;
  58. PROCEDURE WriteMsg(CONST Path: PathStr; MNum: Word; Hdr: MsgHdrType; Len:WORD; Txt: Pointer);
  59.  
  60. PROCEDURE SetTimeStamp(VAR Hdr:MsgHdrType);
  61.  
  62. PROCEDURE FindMsgAdr(CONST h: MsgHdrType; buf:POINTER; Len:WORD; VAR Orig,Dest:TFidoAddress);
  63. PROCEDURE FindMsgKludges(Buf:POINTER; Len:WORD; VAR Dir,Imp,Hold:BOOLEAN);
  64.  
  65. IMPLEMENTATION
  66.  
  67. USES OpString, OpDate, OpRoot,
  68.      StrUtil, LogFile, Util, MailUtil, Globals;
  69.  
  70.  
  71. PROCEDURE FindMsgAdr(CONST h: MsgHdrType; buf:POINTER; Len:WORD; VAR Orig,Dest:TFidoAddress);
  72. VAR
  73.   Test:INTEGER;
  74.   x:WORD;
  75.   s:STRING;
  76.   Tmp:TFidoAddress;
  77. BEGIN
  78.   FILLCHAR(Dest,SizeOf(TFidoAddress),0);
  79.   FILLCHAR(Orig,SizeOf(TFidoAddress),0);
  80.   Dest.Net:=h.DestNet;
  81.   Dest.Node:=h.DestNode;
  82.   Orig.Net:=h.OrigNet;
  83.   Orig.Node:=h.OrigNode;
  84.   x:=0;
  85.   s:='';
  86.   REPEAT
  87.     INC(x);
  88.   UNTIL (CT(buf^)[x]=#1) OR (x>=len);
  89.   DEC(x);
  90.   REPEAT
  91.     INC(x);
  92.     IF (CT(buf^)[x] IN [#10,#13]) THEN
  93.     BEGIN
  94.       IF (COPY(s,1,5)=#1'FMPT') THEN VAL(COPY(s,6,10),Orig.Point,Test) ELSE
  95.         IF (COPY(s,1,5)=#1'TOPT') OR (COPY(s,1,5)=#1'*2PT') THEN VAL(COPY(s,6,10),Dest.Point,Test) ELSE
  96.           IF (COPY(s,1,6)=#1'MSGID') THEN
  97.           BEGIN
  98.             DELETE(s,1,POS(' ',s));
  99.             GetAdressFromStr(NextWord(' ',s),Orig);
  100.           END
  101.           ELSE
  102.             IF COPY(s,1,5)=#1'INTL' THEN
  103.             BEGIN
  104.               DELETE(s,1,POS(' ',s));
  105.               GetAdressFromStr(NextWord(' ',s),Tmp);
  106.               Dest.Zone:=Tmp.Zone;
  107.               Dest.Net :=Tmp.Net ;
  108.               Dest.Node:=Tmp.Node;
  109.               GetAdressFromStr(s,Tmp);
  110.               Orig.Zone:=Tmp.Zone;
  111.               Orig.Net :=Tmp.Net ;
  112.               Orig.Node:=Tmp.Node;
  113.             END;
  114.       s:='';
  115.     END ELSE
  116.     BEGIN
  117.       s:=s+CT(buf^)[x];
  118.     END;
  119.   UNTIL ((s<>'') AND (s[1]<>#1)) OR (x>=len);
  120.   IF Dest.Zone=0 THEN Dest.Zone:=Cfg.Addresses[Cfg.MainAdrNum].Zone;
  121.   IF Orig.Zone=0 THEN Orig.Zone:=Cfg.Addresses[Cfg.MainAdrNum].Zone;
  122. END;
  123.  
  124. PROCEDURE FindMsgKludges(Buf:POINTER; Len:WORD; VAR Dir,Imp,Hold:BOOLEAN);
  125. VAR
  126.   i:WORD;
  127.   ch:CHAR;
  128.   s:STRING;
  129. BEGIN
  130.   Dir:=FALSE;
  131.   Imp:=FALSE;
  132.   Hold:=FALSE;
  133.   i:=0;
  134.   s:='';
  135.   WHILE (i<=Len) DO
  136.   BEGIN
  137.     ch:=CT0(Buf^)[i];
  138.     IF (ch<>#10) AND (ch<>#13) THEN s:=s+Ch ELSE
  139.     BEGIN
  140.       IF s<>'' THEN
  141.       BEGIN
  142.         IF s[1]<>#1 THEN Break;
  143.         IF COPY(s,1,6)=#1'FLAGS' THEN
  144.         BEGIN
  145.           s:=Trim(COPY(s,7,255))+' ';
  146.           IF POS('DIR ',s)>0 THEN Dir:=TRUE;
  147.           IF POS('IMM ',s)>0 THEN Imp:=TRUE;
  148.           IF POS('HLD ',s)>0 THEN Hold:=TRUE;
  149.         END;
  150.       END;
  151.       s:='';
  152.     END;
  153.     INC(i);
  154.   END;
  155. END;
  156.  
  157. PROCEDURE SetTimeStamp(VAR Hdr:MsgHdrType);
  158. VAR
  159.   D,M,Y,DoW:WORD;
  160.   s:STRING;
  161. BEGIN
  162.   WITH Hdr DO
  163.   BEGIN
  164.     GetDate(Y,M,D,DoW);
  165.     s:=LongIntForm('@#',d)+' '+COPY(MonthString[m],1,3)+' '+LongIntForm('##',Y MOD 100)+'  '+CurrentTimeString('hh:mm:ss');
  166.     Str2AsciiZ(s,DateTime,20);
  167.   END;
  168. END;
  169.  
  170. FUNCTION GetHighestMsg(CONST Path: PathStr): Word;
  171. VAR
  172.   SRec : SearchRec;
  173.   High, MNum : Word;
  174.   Ok         : Integer;
  175. BEGIN
  176.   FindFirst(AddBackSlash(Path)+'*.MSG',AnyFile,Srec);
  177.   High:=0;
  178.   WHILE DOSError=0 DO
  179.   BEGIN
  180.     Val(Copy(SRec.Name,1,Pos('.',SRec.Name)-1),MNum,Ok);
  181.     IF MNum>High THEN High:=MNum;
  182.     FindNext(SRec);
  183.   END;
  184.   FindClose(SRec);
  185.   GetHighestMsg:=High;
  186. END;
  187.  
  188. FUNCTION ReadMsg(CONST Path: PathStr; MNum:Word; VAR Hdr: MsgHdrType; VAR TxtLen: LongInt; VAR Txt: Pointer): BOOLEAN;
  189. VAR
  190.   f:FILE;
  191.   test:WORD;
  192.   s: PathStr;
  193. BEGIN
  194.   ReadMsg:=FALSE;
  195.   s:=AddBackSlash(Path)+Long2Str(MNum)+'.MSG';
  196.   ASSIGN(f,s); FileMode:=ShareRead+ShareDenyW;
  197.   RESET(f,1);
  198.   IF IoResult<>0 THEN EXIT;
  199.   BLOCKREAD(f,Hdr,SizeOf(Hdr),Test);
  200.   IF Test<SizeOf(Hdr) THEN
  201.   BEGIN
  202.     CLOSE(f);
  203.     EXIT;
  204.   END;
  205.   TxtLen:=FileSize(f)-FilePos(f);
  206.   IF (TxtLen>64000) OR NOT GetMemCheck(Txt, TxtLen) THEN
  207.   BEGIN
  208.     CLOSE(f);
  209.     EXIT;
  210.   END;
  211.   BlockRead(f, txt^, TxtLen, Test);
  212.   CLOSE(f);
  213.   IF (Test<TxtLen) OR (MaxAvail<4096) THEN
  214.     FreeMemCheck(txt,TxtLen)
  215.   ELSE
  216.     ReadMsg:=TRUE;
  217. END;
  218.  
  219. PROCEDURE WriteMsg(CONST Path: PathStr; MNum: Word; Hdr: MsgHdrType; Len:WORD; Txt:POINTER);
  220. VAR
  221.   MsgFile : File;
  222.   Written : Word;
  223. BEGIN
  224.   Assign(MsgFile, AddBackSlash(Path)+Long2Str(MNum)+'.MSG');
  225.   ReWrite(MsgFile,1);
  226.   BlockWrite(MsgFile,Hdr,SizeOf(Hdr),Written);
  227.   IF Written<>SizeOf(Hdr) THEN
  228.     AddLog('!','Error writing message')
  229.   ELSE
  230.     BlockWrite(MsgFile,Txt^, Len,Written);
  231.   IF Written<>Len THEN
  232.     AddLog('!','Error writing message');
  233.   Close(MsgFile);
  234. END;
  235.  
  236. END.
  237.